home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 011 / sideways.pas < prev    next >
Pascal/Delphi Source File  |  1985-06-03  |  4KB  |  119 lines
  1.  
  2. {$line+,$symtab-,$linesize:131,$pagesize:65}
  3. program sideways(input,output,infile);
  4.  
  5. {COPYRIGHT @ 1983
  6.       Jim Holtman
  7.       35 Dogwood Trail
  8.       Randolph, NJ 07869
  9.       (201) 361-3396}
  10.  
  11. {This program will print the `infile' sideways on an EPSON MX-80 Printer.
  12.  It makes use of the characters in the PC's ROM for the graphics mode of
  13.  the CRT. The characters in the file are `looked up' and then the graphics
  14.  mode of the printer is used for output.}
  15.  
  16. { The DEBUG statements will output on the CRT the current line being printed.
  17.   The line will appear vertically. }
  18.  
  19. type
  20.     vstr = super array[0..*] of char;
  21.     CHAR_PER_LINE = 0..2000;        {Maximum input line size}
  22.  
  23. const
  24.     EOF = chr(26);            {TEXT EOF character}
  25.     EOL = chr(13);
  26.     TAB = chr(9);            {expand TABs}
  27.     IGNORE = [chr(0)..chr(8),chr(10)..chr(#1f),chr(#80)..chr(#FF)];
  28.     MAX_LINES = 48;            {Lines/Page}
  29.     SPACES_PER_LINE = 2;        {2/72th inch space between lines}
  30.     SPACES_PER_LETTER = 8;        {DOT size of characters}
  31.  
  32. var
  33.     lptr : array[1..MAX_LINES] of ^vstr; {input lines}
  34.     inbuf : array[CHAR_PER_LINE] of char;
  35.     linesize : CHAR_PER_LINE;
  36.     indx : 0..MAX_LINES;
  37.     line : 0..MAX_LINES+1;
  38.     infile : file of char;
  39.     printer : text;
  40.     col : CHAR_PER_LINE;
  41.     pchar : integer;
  42.     ichar : 0..7;
  43.     max : CHAR_PER_LINE;
  44.     rom : ads of array[0..32000] of char;
  45.  
  46. value
  47.   {NOTE!!!!
  48.      The following declarations define the segment and offset values
  49.      for the characters in the PC version of the ROM. For the XT, check
  50.      the TECH MANUAL for the correct values.}
  51.  
  52.     rom.s := #F000; {address of the CRT character generation}
  53.     rom.r := #FA6E; {matrix in the ROM -- for non-XT versions of PC}
  54.  
  55. begin
  56.     assign(printer,'lpt1:');            {open the printer}
  57.     rewrite(printer);
  58.     reset(infile);
  59.     repeat
  60.     max := 0;
  61.     linesize := 0;
  62.     line := 1;
  63.     while (line <= MAX_LINES) do begin
  64.         if infile^ = EOL then begin {check for End-of-Line}
  65.         new(lptr[line],linesize+1);  {allocate string storage}
  66.         movel(adr inbuf[0],adr lptr[line]^[0],wrd(linesize+1)); {save}
  67.         if linesize > max then max := linesize;
  68.         linesize := 0;
  69.         line := line+1;
  70.         get(infile);
  71.         writeln(output,'<<');   {--DEBUG--}
  72.         cycle;
  73.         end;
  74.         if infile^ = EOF then break;
  75.         if not(infile^ in IGNORE) then begin
  76.         if infile^ = TAB then
  77.             repeat        {Expand TABs}
  78.             linesize := linesize+1;
  79.             inbuf[linesize] := ' ';
  80.             until (linesize mod 8) = 0
  81.         else begin
  82.             linesize := linesize+1;
  83.             inbuf[linesize] := infile^;
  84.         end;
  85.         write(output,infile^);    {--DEBUG--}
  86.         end;
  87.         get(infile);
  88.     end;
  89.     writeln(output,'line=',line,' max=',max);  {--DEBUG--}
  90.     if infile^ <> EOF then line := MAX_LINES
  91.     else line := line-1;
  92.     for col := 1 to max do begin    {Output collected lines}
  93.         write(printer,chr(27)*'A'*chr(SPACES_PER_LETTER)*chr(27)*'K',
  94.              chr((line*(8+SPACES_PER_LINE)) mod 256),
  95.              chr((line*(8+SPACES_PER_LINE)) div 256));
  96.         for indx := line downto 1 do begin    {Scan next column}
  97.         {if column pointer is larger than string, output BLANK}
  98.         if col > upper(lptr[indx]^) then pchar := ord(' ')
  99.         else pchar := ord(lptr[indx]^[col]);
  100.         write(output,chr(pchar));  {--DEBUG--}
  101.         pchar := pchar*8;
  102.         for ichar := 7 downto 0 do  {Pickup character, a line at a time, }
  103.             write(printer,rom^[pchar+ichar]); {from ROM}
  104.         for ichar := 1 to SPACES_PER_LINE do write(printer,chr(0));
  105.         end;
  106.         writeln(printer);
  107.         writeln(output);        {--DEBUG--}
  108.     end;
  109.     for indx := 1 to line do dispose(lptr[indx]);  {Free up space on HEAP}
  110.     page(printer);
  111.     until infile^ = EOF;
  112. end.
  113. nd;
  114.     for indx := 1 to line do disose(lptr[indx]);  {Free up space on HEAP}
  115.     page(printer);
  116.     until infile^ = EOF;
  117. end.
  118. nd;
  119.     for indx := 1 to line do dis